home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / compiler / ltv.lisp < prev    next >
Encoding:
Text File  |  1991-11-25  |  1.9 KB  |  61 lines
  1. ;;; -*- Package: C; Log: C.Log -*-
  2. ;;;
  3. ;;; **********************************************************************
  4. ;;; This code was written as part of the CMU Common Lisp project at
  5. ;;; Carnegie Mellon University, and has been placed in the public domain.
  6. ;;; If you want to use this code or any part of CMU Common Lisp, please contact
  7. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
  8. ;;;
  9. (ext:file-comment
  10.   "$Header: ltv.lisp,v 1.1 91/11/25 12:09:36 wlott Exp $")
  11. ;;;
  12. ;;; **********************************************************************
  13. ;;;
  14. ;;; This file implements LOAD-TIME-VALUE.
  15. ;;;
  16. ;;; Written by William Lott
  17. ;;;
  18. (in-package "C")
  19.  
  20. (in-package "LISP")
  21. (export 'load-time-value)
  22.  
  23. (in-package "C")
  24.  
  25. (defknown %load-time-value (t) t (flushable movable))
  26.  
  27. (def-ir1-translator load-time-value ((form &optional read-only-p) start cont)
  28.   "Arrange for FORM to be evaluated at load-time and use the value produced
  29.    as if it were a constant.  If READ-ONLY-P is non-NIL, then the resultant
  30.    object is guaranteed to never be modified, so it can be put in read-only
  31.    storage."
  32.   (if (producing-fasl-file)
  33.       (multiple-value-bind
  34.       (handle type)
  35.       (compile-load-time-value (if read-only-p
  36.                        form
  37.                        `(make-value-cell ,form)))
  38.     (declare (ignore type))
  39.     (ir1-convert start cont
  40.              (if read-only-p
  41.              `(%load-time-value ',handle)
  42.              `(value-cell-ref (%load-time-value ',handle)))))
  43.       (let ((value
  44.          (handler-case (eval form)
  45.            (error (condition)
  46.          (compiler-error "(during EVAL of LOAD-TIME-VALUE)~%~A"
  47.                  condition)))))
  48.     (ir1-convert start cont
  49.              (if read-only-p
  50.              `',value
  51.              `(value-cell-ref ',(make-value-cell value)))))))
  52.  
  53.  
  54. (defoptimizer (%load-time-value ir2-convert) ((handle) node block)
  55.   (assert (constant-continuation-p handle))
  56.   (let ((cont (node-cont node))
  57.     (tn (make-load-time-value-tn (continuation-value handle)
  58.                      *universal-type*)))
  59.     (move-continuation-result node block (list tn) cont)))
  60.            
  61.